home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / BARNET / ARMTEX / SOURCES2 / !TeX / texmf / source / armTeX / web / tangle / p < prev    next >
Encoding:
Text File  |  1998-04-04  |  46.5 KB  |  827 lines
  1. {2:}program TANGLE;label 9999;const{8:}bufsize=100;maxbytes=45000;
  2. maxtoks=50000;maxnames=4000;maxtexts=2000;hashsize=353;longestname=400;
  3. linelength=72;outbufsize=144;stacksize=100;maxidlength=50;
  4. unambiglength=20;{:8}type{11:}ASCIIcode=0..255;{:11}{12:}
  5. textfile=packed file of ASCIIcode;{:12}{37:}eightbits=0..255;
  6. sixteenbits=0..65535;{:37}{39:}namepointer=0..maxnames;{:39}{43:}
  7. textpointer=0..maxtexts;{:43}{78:}
  8. outputstate=record endfield:sixteenbits;bytefield:sixteenbits;
  9. namefield:namepointer;replfield:textpointer;modfield:0..12287;end;{:78}
  10. var{9:}history:0..3;{:9}{13:}xord:array[ASCIIcode]of ASCIIcode;
  11. xchr:array[ASCIIcode]of ASCIIcode;{:13}{23:}webfile:textfile;
  12. changefile:textfile;{:23}{25:}Pascalfile:textfile;pool:textfile;{:25}
  13. {27:}buffer:array[0..bufsize]of ASCIIcode;{:27}{29:}phaseone:boolean;
  14. {:29}{38:}bytemem:packed array[0..2,0..maxbytes]of ASCIIcode;
  15. tokmem:packed array[0..3,0..maxtoks]of eightbits;
  16. bytestart:array[0..maxnames]of sixteenbits;
  17. tokstart:array[0..maxtexts]of sixteenbits;
  18. link:array[0..maxnames]of sixteenbits;
  19. ilk:array[0..maxnames]of sixteenbits;
  20. equiv:array[0..maxnames]of sixteenbits;
  21. textlink:array[0..maxtexts]of sixteenbits;{:38}{40:}nameptr:namepointer;
  22. stringptr:namepointer;byteptr:array[0..2]of 0..maxbytes;
  23. poolchecksum:integer;{:40}{44:}textptr:textpointer;
  24. tokptr:array[0..3]of 0..maxtoks;z:0..3;
  25. {maxtokptr:array[0..3]of 0..maxtoks;}{:44}{50:}idfirst:0..bufsize;
  26. idloc:0..bufsize;doublechars:0..bufsize;
  27. hash,chophash:array[0..hashsize]of sixteenbits;
  28. choppedid:array[0..unambiglength]of ASCIIcode;{:50}{65:}
  29. modtext:array[0..longestname]of ASCIIcode;{:65}{70:}
  30. lastunnamed:textpointer;{:70}{79:}curstate:outputstate;
  31. stack:array[1..stacksize]of outputstate;stackptr:0..stacksize;{:79}{80:}
  32. zo:0..3;{:80}{82:}bracelevel:eightbits;{:82}{86:}curval:integer;{:86}
  33. {94:}outbuf:array[0..outbufsize]of ASCIIcode;outptr:0..outbufsize;
  34. breakptr:0..outbufsize;semiptr:0..outbufsize;{:94}{95:}
  35. outstate:eightbits;outval,outapp:integer;outsign:ASCIIcode;
  36. lastsign:-1..+1;{:95}{100:}outcontrib:array[1..linelength]of ASCIIcode;
  37. {:100}{124:}ii:integer;line:integer;otherline:integer;templine:integer;
  38. limit:0..bufsize;loc:0..bufsize;inputhasended:boolean;changing:boolean;
  39. {:124}{126:}changebuffer:array[0..bufsize]of ASCIIcode;
  40. changelimit:0..bufsize;{:126}{143:}curmodule:namepointer;
  41. scanninghex:boolean;{:143}{156:}nextcontrol:eightbits;{:156}{164:}
  42. currepltext:textpointer;{:164}{171:}modulecount:0..12287;{:171}{179:}
  43. {troubleshooting:boolean;ddt:integer;dd:integer;debugcycle:integer;
  44. debugskipped:integer;}{:179}{185:}{wo:0..2;}{:185}{189:}
  45. webname,chgname,pascalfilename,poolfilename:array[1..PATHMAX]of char;
  46. {:189}{30:}{procedure debughelp;forward;}{:30}{31:}procedure error;
  47. var j:0..outbufsize;k,l:0..bufsize;begin if phaseone then{32:}
  48. begin if changing then write(stdout,'. (change file ')else write(stdout,
  49. '. (');writeln(stdout,'l.',line:1,')');
  50. if loc>=limit then l:=limit else l:=loc;
  51. for k:=1 to l do if buffer[k-1]=9 then write(stdout,' ')else write(
  52. stdout,xchr[buffer[k-1]]);writeln(stdout);
  53. for k:=1 to l do write(stdout,' ');
  54. for k:=l+1 to limit do write(stdout,xchr[buffer[k-1]]);
  55. write(stdout,' ');end{:32}else{33:}
  56. begin writeln(stdout,'. (l.',line:1,')');
  57. for j:=1 to outptr do write(stdout,xchr[outbuf[j-1]]);
  58. write(stdout,'... ');end{:33};flush(stdout);history:=2;{debughelp;}end;
  59. {:31}{190:}procedure scanargs;var dotpos,slashpos,i,a:integer;c:char;
  60. fname:array[1..PATHMAX]of char;foundweb,foundchange:boolean;
  61. begin foundweb:=false;foundchange:=false;
  62. for a:=1 to argc-1 do begin argv(a,fname);
  63. if fname[1]<>'-'then begin if not foundweb then{191:}begin dotpos:=-1;
  64. slashpos:=-1;i:=1;
  65. while(fname[i]<>' ')and(i<=PATHMAX-5)do begin webname[i]:=fname[i];
  66. if fname[i]='.'then dotpos:=i;if fname[i]='/'then slashpos:=i;i:=i+1;
  67. end;webname[i]:=' ';
  68. if(dotpos=-1)or(dotpos<slashpos)then begin dotpos:=i;
  69. webname[dotpos]:='.';webname[dotpos+1]:='w';webname[dotpos+2]:='e';
  70. webname[dotpos+3]:='b';webname[dotpos+4]:=' ';end;
  71. for i:=1 to dotpos do begin c:=webname[i];pascalfilename[i]:=c;
  72. poolfilename[i]:=c;end;pascalfilename[dotpos+1]:='p';
  73. pascalfilename[dotpos+2]:=' ';poolfilename[dotpos+1]:='p';
  74. poolfilename[dotpos+2]:='o';poolfilename[dotpos+3]:='o';
  75. poolfilename[dotpos+4]:='l';poolfilename[dotpos+5]:=' ';foundweb:=true;
  76. end{:191}else if not foundchange then{192:}begin dotpos:=-1;
  77. slashpos:=-1;i:=1;
  78. while(fname[i]<>' ')and(i<=PATHMAX-5)do begin chgname[i]:=fname[i];
  79. if fname[i]='.'then dotpos:=i;if fname[i]='/'then slashpos:=i;i:=i+1;
  80. end;chgname[i]:=' ';
  81. if(dotpos=-1)or(dotpos<slashpos)then begin dotpos:=i;
  82. chgname[dotpos]:='.';chgname[dotpos+1]:='c';chgname[dotpos+2]:='h';
  83. chgname[dotpos+3]:=' ';end;foundchange:=true;end{:192}else{195:}
  84. begin writeln(stdout,
  85. 'Usage: tangle webfile[.web] [changefile[.ch]] [-o file] [-p poolfile]')
  86. ;uexit(1);end{:195};end else{194:}
  87. begin if fname[2]='o'then begin a:=a+1;argv(a,pascalfilename);
  88. end else if fname[2]='p'then begin a:=a+1;argv(a,poolfilename);
  89. end else{195:}begin writeln(stdout,
  90. 'Usage: tangle webfile[.web] [changefile[.ch]] [-o file] [-p poolfile]')
  91. ;uexit(1);end{:195};end{:194};end;if not foundweb then{195:}
  92. begin writeln(stdout,
  93. 'Usage: tangle webfile[.web] [changefile[.ch]] [-o file] [-p poolfile]')
  94. ;uexit(1);end{:195};if not foundchange then{193:}begin chgname[1]:='n';
  95. chgname[2]:='u';chgname[3]:='l';chgname[4]:='l';chgname[5]:=':';
  96. chgname[6]:=' ';end{:193};end;{:190}procedure initialize;var{16:}
  97. i:0..255;{:16}{41:}wi:0..2;{:41}{45:}zi:0..3;{:45}{51:}h:0..hashsize;
  98. {:51}begin{10:}history:=0;{:10}{14:}xchr[32]:=' ';xchr[33]:='!';
  99. xchr[34]:='"';xchr[35]:='#';xchr[36]:='$';xchr[37]:='%';xchr[38]:='&';
  100. xchr[39]:='''';xchr[40]:='(';xchr[41]:=')';xchr[42]:='*';xchr[43]:='+';
  101. xchr[44]:=',';xchr[45]:='-';xchr[46]:='.';xchr[47]:='/';xchr[48]:='0';
  102. xchr[49]:='1';xchr[50]:='2';xchr[51]:='3';xchr[52]:='4';xchr[53]:='5';
  103. xchr[54]:='6';xchr[55]:='7';xchr[56]:='8';xchr[57]:='9';xchr[58]:=':';
  104. xchr[59]:=';';xchr[60]:='<';xchr[61]:='=';xchr[62]:='>';xchr[63]:='?';
  105. xchr[64]:='@';xchr[65]:='A';xchr[66]:='B';xchr[67]:='C';xchr[68]:='D';
  106. xchr[69]:='E';xchr[70]:='F';xchr[71]:='G';xchr[72]:='H';xchr[73]:='I';
  107. xchr[74]:='J';xchr[75]:='K';xchr[76]:='L';xchr[77]:='M';xchr[78]:='N';
  108. xchr[79]:='O';xchr[80]:='P';xchr[81]:='Q';xchr[82]:='R';xchr[83]:='S';
  109. xchr[84]:='T';xchr[85]:='U';xchr[86]:='V';xchr[87]:='W';xchr[88]:='X';
  110. xchr[89]:='Y';xchr[90]:='Z';xchr[91]:='[';xchr[92]:='\';xchr[93]:=']';
  111. xchr[94]:='^';xchr[95]:='_';xchr[96]:='`';xchr[97]:='a';xchr[98]:='b';
  112. xchr[99]:='c';xchr[100]:='d';xchr[101]:='e';xchr[102]:='f';
  113. xchr[103]:='g';xchr[104]:='h';xchr[105]:='i';xchr[106]:='j';
  114. xchr[107]:='k';xchr[108]:='l';xchr[109]:='m';xchr[110]:='n';
  115. xchr[111]:='o';xchr[112]:='p';xchr[113]:='q';xchr[114]:='r';
  116. xchr[115]:='s';xchr[116]:='t';xchr[117]:='u';xchr[118]:='v';
  117. xchr[119]:='w';xchr[120]:='x';xchr[121]:='y';xchr[122]:='z';
  118. xchr[123]:='{';xchr[124]:='|';xchr[125]:='}';xchr[126]:='~';
  119. xchr[0]:=' ';xchr[127]:=' ';{:14}{17:}for i:=1 to 31 do xchr[i]:=chr(i);
  120. for i:=128 to 255 do xchr[i]:=chr(i);{:17}{18:}
  121. for i:=0 to 255 do xord[chr(i)]:=32;for i:=1 to 255 do xord[xchr[i]]:=i;
  122. xord[' ']:=32;{:18}{21:}{:21}{26:}scanargs;
  123. rewrite(Pascalfile,pascalfilename);{:26}{42:}
  124. for wi:=0 to 2 do begin bytestart[wi]:=0;byteptr[wi]:=0;end;
  125. bytestart[3]:=0;nameptr:=1;stringptr:=256;poolchecksum:=271828;{:42}
  126. {46:}for zi:=0 to 3 do begin tokstart[zi]:=0;tokptr[zi]:=0;end;
  127. tokstart[4]:=0;textptr:=1;z:=1 mod 4;{:46}{48:}ilk[0]:=0;equiv[0]:=0;
  128. {:48}{52:}for h:=0 to hashsize-1 do begin hash[h]:=0;chophash[h]:=0;end;
  129. {:52}{71:}lastunnamed:=0;textlink[0]:=0;{:71}{144:}scanninghex:=false;
  130. {:144}{152:}modtext[0]:=32;{:152}{180:}{troubleshooting:=true;
  131. debugcycle:=1;debugskipped:=0;troubleshooting:=false;debugcycle:=99999;}
  132. {:180}end;{:2}{24:}procedure openinput;begin reset(webfile,webname);
  133. reset(changefile,chgname);end;{:24}{28:}
  134. function inputln(var f:textfile):boolean;var finallimit:0..bufsize;
  135. begin limit:=0;finallimit:=0;
  136. if eof(f)then inputln:=false else begin while not eoln(f)do begin buffer
  137. [limit]:=xord[getc(f)];limit:=limit+1;
  138. if buffer[limit-1]<>32 then finallimit:=limit;
  139. if limit=bufsize then begin while not eoln(f)do vgetc(f);limit:=limit-1;
  140. if finallimit>limit then finallimit:=limit;begin writeln(stdout);
  141. write(stdout,'! Input line too long');end;loc:=0;error;end;end;
  142. readln(f);limit:=finallimit;inputln:=true;end;end;{:28}{49:}
  143. procedure printid(p:namepointer);var k:0..maxbytes;w:0..2;
  144. begin if p>=nameptr then write(stdout,'IMPOSSIBLE')else begin w:=p mod 3
  145. ;
  146. for k:=bytestart[p]to bytestart[p+3]-1 do write(stdout,xchr[bytemem[w,k]
  147. ]);end;end;{:49}{53:}function idlookup(t:eightbits):namepointer;
  148. label 31,32;var c:eightbits;i:0..bufsize;h:0..hashsize;k:0..maxbytes;
  149. w:0..2;l:0..bufsize;p,q:namepointer;s:0..unambiglength;
  150. begin l:=idloc-idfirst;{54:}h:=buffer[idfirst];i:=idfirst+1;
  151. while i<idloc do begin h:=(h+h+buffer[i])mod hashsize;i:=i+1;end{:54};
  152. {55:}p:=hash[h];
  153. while p<>0 do begin if bytestart[p+3]-bytestart[p]=l then{56:}
  154. begin i:=idfirst;k:=bytestart[p];w:=p mod 3;
  155. while(i<idloc)and(buffer[i]=bytemem[w,k])do begin i:=i+1;k:=k+1;end;
  156. if i=idloc then goto 31;end{:56};p:=link[p];end;p:=nameptr;
  157. link[p]:=hash[h];hash[h]:=p;31:{:55};if(p=nameptr)or(t<>0)then{57:}
  158. begin if((p<>nameptr)and(t<>0)and(ilk[p]=0))or((p=nameptr)and(t=0)and(
  159. buffer[idfirst]<>34))then{58:}begin i:=idfirst;s:=0;h:=0;
  160. while(i<idloc)and(s<unambiglength)do begin if buffer[i]<>95 then begin
  161. if buffer[i]>=97 then choppedid[s]:=buffer[i]-32 else choppedid[s]:=
  162. buffer[i];h:=(h+h+choppedid[s])mod hashsize;s:=s+1;end;i:=i+1;end;
  163. choppedid[s]:=0;end{:58};if p<>nameptr then{59:}
  164. begin if ilk[p]=0 then begin if t=1 then begin writeln(stdout);
  165. write(stdout,'! This identifier has already appeared');error;end;{60:}
  166. q:=chophash[h];
  167. if q=p then chophash[h]:=equiv[p]else begin while equiv[q]<>p do q:=
  168. equiv[q];equiv[q]:=equiv[p];end{:60};end else begin writeln(stdout);
  169. write(stdout,'! This identifier was defined before');error;end;
  170. ilk[p]:=t;end{:59}else{61:}
  171. begin if(t=0)and(buffer[idfirst]<>34)then{62:}begin q:=chophash[h];
  172. while q<>0 do begin{63:}begin k:=bytestart[q];s:=0;w:=q mod 3;
  173. while(k<bytestart[q+3])and(s<unambiglength)do begin c:=bytemem[w,k];
  174. if c<>95 then begin if choppedid[s]<>c then goto 32;s:=s+1;end;k:=k+1;
  175. end;if(k=bytestart[q+3])and(choppedid[s]<>0)then goto 32;
  176. begin writeln(stdout);write(stdout,'! Identifier conflict with ');end;
  177. for k:=bytestart[q]to bytestart[q+3]-1 do write(stdout,xchr[bytemem[w,k]
  178. ]);error;q:=0;32:end{:63};q:=equiv[q];end;equiv[p]:=chophash[h];
  179. chophash[h]:=p;end{:62};w:=nameptr mod 3;k:=byteptr[w];
  180. if k+l>maxbytes then begin writeln(stdout);
  181. write(stdout,'! Sorry, ','byte memory',' capacity exceeded');error;
  182. history:=3;uexit(1);end;
  183. if nameptr>maxnames-3 then begin writeln(stdout);
  184. write(stdout,'! Sorry, ','name',' capacity exceeded');error;history:=3;
  185. uexit(1);end;i:=idfirst;while i<idloc do begin bytemem[w,k]:=buffer[i];
  186. k:=k+1;i:=i+1;end;byteptr[w]:=k;bytestart[nameptr+3]:=k;
  187. nameptr:=nameptr+1;if buffer[idfirst]<>34 then ilk[p]:=t else{64:}
  188. begin ilk[p]:=1;
  189. if l-doublechars=2 then equiv[p]:=buffer[idfirst+1]+32768 else begin if
  190. stringptr=256 then rewrite(pool,poolfilename);equiv[p]:=stringptr+32768;
  191. l:=l-doublechars-1;if l>99 then begin writeln(stdout);
  192. write(stdout,'! Preprocessed string is too long');error;end;
  193. stringptr:=stringptr+1;write(pool,xchr[48+l div 10],xchr[48+l mod 10]);
  194. poolchecksum:=poolchecksum+poolchecksum+l;
  195. while poolchecksum>536870839 do poolchecksum:=poolchecksum-536870839;
  196. i:=idfirst+1;while i<idloc do begin write(pool,xchr[buffer[i]]);
  197. poolchecksum:=poolchecksum+poolchecksum+buffer[i];
  198. while poolchecksum>536870839 do poolchecksum:=poolchecksum-536870839;
  199. if(buffer[i]=34)or(buffer[i]=64)then i:=i+2 else i:=i+1;end;
  200. writeln(pool);end;end{:64};end{:61};end{:57};idlookup:=p;end;{:53}{66:}
  201. function modlookup(l:sixteenbits):namepointer;label 31;var c:0..4;
  202. j:0..longestname;k:0..maxbytes;w:0..2;p:namepointer;q:namepointer;
  203. begin c:=2;q:=0;p:=ilk[0];while p<>0 do begin{68:}begin k:=bytestart[p];
  204. w:=p mod 3;c:=1;j:=1;
  205. while(k<bytestart[p+3])and(j<=l)and(modtext[j]=bytemem[w,k])do begin k:=
  206. k+1;j:=j+1;end;
  207. if k=bytestart[p+3]then if j>l then c:=1 else c:=4 else if j>l then c:=3
  208. else if modtext[j]<bytemem[w,k]then c:=0 else c:=2;end{:68};q:=p;
  209. if c=0 then p:=link[q]else if c=2 then p:=ilk[q]else goto 31;end;{67:}
  210. w:=nameptr mod 3;k:=byteptr[w];
  211. if k+l>maxbytes then begin writeln(stdout);
  212. write(stdout,'! Sorry, ','byte memory',' capacity exceeded');error;
  213. history:=3;uexit(1);end;
  214. if nameptr>maxnames-3 then begin writeln(stdout);
  215. write(stdout,'! Sorry, ','name',' capacity exceeded');error;history:=3;
  216. uexit(1);end;p:=nameptr;if c=0 then link[q]:=p else ilk[q]:=p;
  217. link[p]:=0;ilk[p]:=0;c:=1;equiv[p]:=0;
  218. for j:=1 to l do bytemem[w,k+j-1]:=modtext[j];byteptr[w]:=k+l;
  219. bytestart[nameptr+3]:=k+l;nameptr:=nameptr+1;{:67};
  220. 31:if c<>1 then begin begin writeln(stdout);
  221. write(stdout,'! Incompatible section names');error;end;p:=0;end;
  222. modlookup:=p;end;{:66}{69:}
  223. function prefixlookup(l:sixteenbits):namepointer;var c:0..4;
  224. count:0..maxnames;j:0..longestname;k:0..maxbytes;w:0..2;p:namepointer;
  225. q:namepointer;r:namepointer;begin q:=0;p:=ilk[0];count:=0;r:=0;
  226. while p<>0 do begin{68:}begin k:=bytestart[p];w:=p mod 3;c:=1;j:=1;
  227. while(k<bytestart[p+3])and(j<=l)and(modtext[j]=bytemem[w,k])do begin k:=
  228. k+1;j:=j+1;end;
  229. if k=bytestart[p+3]then if j>l then c:=1 else c:=4 else if j>l then c:=3
  230. else if modtext[j]<bytemem[w,k]then c:=0 else c:=2;end{:68};
  231. if c=0 then p:=link[p]else if c=2 then p:=ilk[p]else begin r:=p;
  232. count:=count+1;q:=ilk[p];p:=link[p];end;if p=0 then begin p:=q;q:=0;end;
  233. end;if count<>1 then if count=0 then begin writeln(stdout);
  234. write(stdout,'! Name does not match');error;
  235. end else begin writeln(stdout);write(stdout,'! Ambiguous prefix');error;
  236. end;prefixlookup:=r;end;{:69}{73:}
  237. procedure storetwobytes(x:sixteenbits);
  238. begin if tokptr[z]+2>maxtoks then begin writeln(stdout);
  239. write(stdout,'! Sorry, ','token',' capacity exceeded');error;history:=3;
  240. uexit(1);end;tokmem[z,tokptr[z]]:=x div 256;
  241. tokmem[z,tokptr[z]+1]:=x mod 256;tokptr[z]:=tokptr[z]+2;end;{:73}{74:}
  242. {procedure printrepl(p:textpointer);var k:0..maxtoks;a:sixteenbits;
  243. zp:0..3;
  244. begin if p>=textptr then write(stdout,'BAD')else begin k:=tokstart[p];
  245. zp:=p mod 4;while k<tokstart[p+4]do begin a:=tokmem[zp,k];
  246. if a>=128 then[75:]begin k:=k+1;
  247. if a<168 then begin a:=(a-128)*256+tokmem[zp,k];printid(a);
  248. if bytemem[a mod 3,bytestart[a]]=34 then write(stdout,'"')else write(
  249. stdout,' ');end else if a<208 then begin write(stdout,'@<');
  250. printid((a-168)*256+tokmem[zp,k]);write(stdout,'@>');
  251. end else begin a:=(a-208)*256+tokmem[zp,k];
  252. write(stdout,'@',xchr[123],a:1,'@',xchr[125]);end;
  253. end[:75]else[76:]case a of 9:write(stdout,'@',xchr[123]);
  254. 10:write(stdout,'@',xchr[125]);12:write(stdout,'@''');
  255. 13:write(stdout,'@"');125:write(stdout,'@$');0:write(stdout,'#');
  256. 64:write(stdout,'@@');2:write(stdout,'@=');3:write(stdout,'@\');
  257. others:write(stdout,xchr[a])end[:76];k:=k+1;end;end;end;}{:74}{84:}
  258. procedure pushlevel(p:namepointer);
  259. begin if stackptr=stacksize then begin writeln(stdout);
  260. write(stdout,'! Sorry, ','stack',' capacity exceeded');error;history:=3;
  261. uexit(1);end else begin stack[stackptr]:=curstate;stackptr:=stackptr+1;
  262. curstate.namefield:=p;curstate.replfield:=equiv[p];
  263. zo:=curstate.replfield mod 4;
  264. curstate.bytefield:=tokstart[curstate.replfield];
  265. curstate.endfield:=tokstart[curstate.replfield+4];curstate.modfield:=0;
  266. end;end;{:84}{85:}procedure poplevel;label 10;
  267. begin if textlink[curstate.replfield]=0 then begin if ilk[curstate.
  268. namefield]=3 then{91:}begin nameptr:=nameptr-1;textptr:=textptr-1;
  269. z:=textptr mod 4;{if tokptr[z]>maxtokptr[z]then maxtokptr[z]:=tokptr[z];
  270. }tokptr[z]:=tokstart[textptr];
  271. {byteptr[nameptr mod 3]:=byteptr[nameptr mod 3]-1;}end{:91};
  272. end else if textlink[curstate.replfield]<maxtexts then begin curstate.
  273. replfield:=textlink[curstate.replfield];zo:=curstate.replfield mod 4;
  274. curstate.bytefield:=tokstart[curstate.replfield];
  275. curstate.endfield:=tokstart[curstate.replfield+4];goto 10;end;
  276. stackptr:=stackptr-1;if stackptr>0 then begin curstate:=stack[stackptr];
  277. zo:=curstate.replfield mod 4;end;10:end;{:85}{87:}
  278. function getoutput:sixteenbits;label 20,30,31;var a:sixteenbits;
  279. b:eightbits;bal:sixteenbits;k:0..maxbytes;w:0..2;
  280. begin 20:if stackptr=0 then begin a:=0;goto 31;end;
  281. if curstate.bytefield=curstate.endfield then begin curval:=-curstate.
  282. modfield;poplevel;if curval=0 then goto 20;a:=129;goto 31;end;
  283. a:=tokmem[zo,curstate.bytefield];
  284. curstate.bytefield:=curstate.bytefield+1;if a<128 then if a=0 then{92:}
  285. begin pushlevel(nameptr-1);goto 20;end{:92}else goto 31;
  286. a:=(a-128)*256+tokmem[zo,curstate.bytefield];
  287. curstate.bytefield:=curstate.bytefield+1;if a<10240 then{89:}
  288. begin case ilk[a]of 0:begin curval:=a;a:=130;end;
  289. 1:begin curval:=equiv[a]-32768;a:=128;end;2:begin pushlevel(a);goto 20;
  290. end;3:begin{90:}
  291. while(curstate.bytefield=curstate.endfield)and(stackptr>0)do poplevel;
  292. if(stackptr=0)or(tokmem[zo,curstate.bytefield]<>40)then begin begin
  293. writeln(stdout);write(stdout,'! No parameter given for ');end;
  294. printid(a);error;goto 20;end;{93:}bal:=1;
  295. curstate.bytefield:=curstate.bytefield+1;
  296. while true do begin b:=tokmem[zo,curstate.bytefield];
  297. curstate.bytefield:=curstate.bytefield+1;
  298. if b=0 then storetwobytes(nameptr+32767)else begin if b>=128 then begin
  299. begin if tokptr[z]=maxtoks then begin writeln(stdout);
  300. write(stdout,'! Sorry, ','token',' capacity exceeded');error;history:=3;
  301. uexit(1);end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;end;
  302. b:=tokmem[zo,curstate.bytefield];
  303. curstate.bytefield:=curstate.bytefield+1;
  304. end else case b of 40:bal:=bal+1;41:begin bal:=bal-1;
  305. if bal=0 then goto 30;end;
  306. 39:repeat begin if tokptr[z]=maxtoks then begin writeln(stdout);
  307. write(stdout,'! Sorry, ','token',' capacity exceeded');error;history:=3;
  308. uexit(1);end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;end;
  309. b:=tokmem[zo,curstate.bytefield];
  310. curstate.bytefield:=curstate.bytefield+1;until b=39;others:end;
  311. begin if tokptr[z]=maxtoks then begin writeln(stdout);
  312. write(stdout,'! Sorry, ','token',' capacity exceeded');error;history:=3;
  313. uexit(1);end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;end;end;end;
  314. 30:{:93};equiv[nameptr]:=textptr;ilk[nameptr]:=2;w:=nameptr mod 3;
  315. k:=byteptr[w];{if k=maxbytes then begin writeln(stdout);
  316. write(stdout,'! Sorry, ','byte memory',' capacity exceeded');error;
  317. history:=3;uexit(1);end;bytemem[w,k]:=35;k:=k+1;byteptr[w]:=k;}
  318. if nameptr>maxnames-3 then begin writeln(stdout);
  319. write(stdout,'! Sorry, ','name',' capacity exceeded');error;history:=3;
  320. uexit(1);end;bytestart[nameptr+3]:=k;nameptr:=nameptr+1;
  321. if textptr>maxtexts-4 then begin writeln(stdout);
  322. write(stdout,'! Sorry, ','text',' capacity exceeded');error;history:=3;
  323. uexit(1);end;textlink[textptr]:=0;tokstart[textptr+4]:=tokptr[z];
  324. textptr:=textptr+1;z:=textptr mod 4{:90};pushlevel(a);goto 20;end;
  325. others:begin writeln(stdout);
  326. write(stdout,'! This can''t happen (','output',')');error;history:=3;
  327. uexit(1);end end;goto 31;end{:89};if a<20480 then{88:}begin a:=a-10240;
  328. if equiv[a]<>0 then pushlevel(a)else if a<>0 then begin begin writeln(
  329. stdout);write(stdout,'! Not present: <');end;printid(a);
  330. write(stdout,'>');error;end;goto 20;end{:88};curval:=a-20480;a:=129;
  331. curstate.modfield:=curval;31:{if troubleshooting then debughelp;}
  332. getoutput:=a;end;{:87}{97:}procedure flushbuffer;var k:0..outbufsize;
  333. b:0..outbufsize;begin b:=breakptr;
  334. if(semiptr<>0)and(outptr-semiptr<=linelength)then breakptr:=semiptr;
  335. for k:=1 to breakptr do write(Pascalfile,xchr[outbuf[k-1]]);
  336. writeln(Pascalfile);line:=line+1;
  337. if line mod 100=0 then begin write(stdout,'.');
  338. if line mod 500=0 then write(stdout,line:1);flush(stdout);end;
  339. if breakptr<outptr then begin if outbuf[breakptr]=32 then begin breakptr
  340. :=breakptr+1;if breakptr>b then b:=breakptr;end;
  341. for k:=breakptr to outptr-1 do outbuf[k-breakptr]:=outbuf[k];end;
  342. outptr:=outptr-breakptr;breakptr:=b-breakptr;semiptr:=0;
  343. if outptr>linelength then begin begin writeln(stdout);
  344. write(stdout,'! Long line must be truncated');error;end;
  345. outptr:=linelength;end;end;{:97}{99:}procedure appval(v:integer);
  346. var k:0..outbufsize;begin k:=outbufsize;repeat outbuf[k]:=v mod 10;
  347. v:=v div 10;k:=k-1;until v=0;repeat k:=k+1;
  348. begin outbuf[outptr]:=outbuf[k]+48;outptr:=outptr+1;end;
  349. until k=outbufsize;end;{:99}{101:}procedure sendout(t:eightbits;
  350. v:sixteenbits);label 20;var k:0..linelength;begin{102:}
  351. 20:case outstate of 1:if t<>3 then begin breakptr:=outptr;
  352. if t=2 then begin outbuf[outptr]:=32;outptr:=outptr+1;end;end;
  353. 2:begin begin outbuf[outptr]:=44-outapp;outptr:=outptr+1;end;
  354. if outptr>linelength then flushbuffer;breakptr:=outptr;end;
  355. 3,4:begin{103:}
  356. if(outval<0)or((outval=0)and(lastsign<0))then begin outbuf[outptr]:=45;
  357. outptr:=outptr+1;
  358. end else if outsign>0 then begin outbuf[outptr]:=outsign;
  359. outptr:=outptr+1;end;appval(abs(outval));
  360. if outptr>linelength then flushbuffer;{:103};outstate:=outstate-2;
  361. goto 20;end;5:{104:}begin if(t=3)or({105:}
  362. ((t=2)and(v=3)and(((outcontrib[1]=68)and(outcontrib[2]=73)and(outcontrib
  363. [3]=86))or((outcontrib[1]=100)and(outcontrib[2]=105)and(outcontrib[3]=
  364. 118))or((outcontrib[1]=77)and(outcontrib[2]=79)and(outcontrib[3]=68))or(
  365. (outcontrib[1]=109)and(outcontrib[2]=111)and(outcontrib[3]=100))))or((t=
  366. 0)and((v=42)or(v=47))){:105})then begin{103:}
  367. if(outval<0)or((outval=0)and(lastsign<0))then begin outbuf[outptr]:=45;
  368. outptr:=outptr+1;
  369. end else if outsign>0 then begin outbuf[outptr]:=outsign;
  370. outptr:=outptr+1;end;appval(abs(outval));
  371. if outptr>linelength then flushbuffer;{:103};outsign:=43;outval:=outapp;
  372. end else outval:=outval+outapp;outstate:=3;goto 20;end{:104};
  373. 0:if t<>3 then breakptr:=outptr;others:end{:102};
  374. if t<>0 then for k:=1 to v do begin outbuf[outptr]:=outcontrib[k];
  375. outptr:=outptr+1;end else begin outbuf[outptr]:=v;outptr:=outptr+1;end;
  376. if outptr>linelength then flushbuffer;
  377. if(t=0)and((v=59)or(v=125))then begin semiptr:=outptr;breakptr:=outptr;
  378. end;if t>=2 then outstate:=1 else outstate:=0 end;{:101}{106:}
  379. procedure sendsign(v:integer);
  380. begin case outstate of 2,4:outapp:=outapp*v;3:begin outapp:=v;
  381. outstate:=4;end;5:begin outval:=outval+outapp;outapp:=v;outstate:=4;end;
  382. others:begin breakptr:=outptr;outapp:=v;outstate:=2;end end;
  383. lastsign:=outapp;end;{:106}{107:}procedure sendval(v:integer);
  384. label 666,10;begin case outstate of 1:begin{110:}
  385. if(outptr=breakptr+3)or((outptr=breakptr+4)and(outbuf[breakptr]=32))then
  386. if((outbuf[outptr-3]=68)and(outbuf[outptr-2]=73)and(outbuf[outptr-1]=86)
  387. )or((outbuf[outptr-3]=100)and(outbuf[outptr-2]=105)and(outbuf[outptr-1]=
  388. 118))or((outbuf[outptr-3]=77)and(outbuf[outptr-2]=79)and(outbuf[outptr-1
  389. ]=68))or((outbuf[outptr-3]=109)and(outbuf[outptr-2]=111)and(outbuf[
  390. outptr-1]=100))then goto 666{:110};outsign:=32;outstate:=3;outval:=v;
  391. breakptr:=outptr;lastsign:=+1;end;0:begin{109:}
  392. if(outptr=breakptr+1)and((outbuf[breakptr]=42)or(outbuf[breakptr]=47))
  393. then goto 666{:109};outsign:=0;outstate:=3;outval:=v;breakptr:=outptr;
  394. lastsign:=+1;end;{108:}2:begin outsign:=43;outstate:=3;outval:=outapp*v;
  395. end;3:begin outstate:=5;outapp:=v;begin writeln(stdout);
  396. write(stdout,'! Two numbers occurred without a sign between them');
  397. error;end;end;4:begin outstate:=5;outapp:=outapp*v;end;
  398. 5:begin outval:=outval+outapp;outapp:=v;begin writeln(stdout);
  399. write(stdout,'! Two numbers occurred without a sign between them');
  400. error;end;end;{:108}others:goto 666 end;goto 10;666:{111:}
  401. if v>=0 then begin if outstate=1 then begin breakptr:=outptr;
  402. begin outbuf[outptr]:=32;outptr:=outptr+1;end;end;appval(v);
  403. if outptr>linelength then flushbuffer;outstate:=1;
  404. end else begin begin outbuf[outptr]:=40;outptr:=outptr+1;end;
  405. begin outbuf[outptr]:=45;outptr:=outptr+1;end;appval(-v);
  406. begin outbuf[outptr]:=41;outptr:=outptr+1;end;
  407. if outptr>linelength then flushbuffer;outstate:=0;end{:111};10:end;
  408. {:107}{113:}procedure sendtheoutput;label 2,21,22;var curchar:eightbits;
  409. k:0..linelength;j:0..maxbytes;w:0..2;n:integer;
  410. begin while stackptr>0 do begin curchar:=getoutput;
  411. 21:case curchar of 0:;{116:}
  412. 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,
  413. 89,90,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,
  414. 114,115,116,117,118,119,120,121,122:begin outcontrib[1]:=curchar;
  415. sendout(2,1);end;130:begin k:=0;j:=bytestart[curval];w:=curval mod 3;
  416. while(k<maxidlength)and(j<bytestart[curval+3])do begin k:=k+1;
  417. outcontrib[k]:=bytemem[w,j];j:=j+1;if outcontrib[k]=95 then k:=k-1;end;
  418. sendout(2,k);end;{:116}{119:}48,49,50,51,52,53,54,55,56,57:begin n:=0;
  419. repeat curchar:=curchar-48;if n>=214748364 then begin writeln(stdout);
  420. write(stdout,'! Constant too big');error;end else n:=10*n+curchar;
  421. curchar:=getoutput;until(curchar>57)or(curchar<48);sendval(n);k:=0;
  422. if curchar=101 then curchar:=69;if curchar=69 then goto 2 else goto 21;
  423. end;125:sendval(poolchecksum);12:begin n:=0;curchar:=48;
  424. repeat curchar:=curchar-48;if n>=268435456 then begin writeln(stdout);
  425. write(stdout,'! Constant too big');error;end else n:=8*n+curchar;
  426. curchar:=getoutput;until(curchar>55)or(curchar<48);sendval(n);goto 21;
  427. end;13:begin n:=0;curchar:=48;
  428. repeat if curchar>=65 then curchar:=curchar-55 else curchar:=curchar-48;
  429. if n>=134217728 then begin writeln(stdout);
  430. write(stdout,'! Constant too big');error;end else n:=16*n+curchar;
  431. curchar:=getoutput;
  432. until(curchar>70)or(curchar<48)or((curchar>57)and(curchar<65));
  433. sendval(n);goto 21;end;128:sendval(curval);46:begin k:=1;
  434. outcontrib[1]:=46;curchar:=getoutput;
  435. if curchar=46 then begin outcontrib[2]:=46;sendout(1,2);
  436. end else if(curchar>=48)and(curchar<=57)then goto 2 else begin sendout(0
  437. ,46);goto 21;end;end;{:119}43,45:sendsign(44-curchar);{114:}
  438. 4:begin outcontrib[1]:=97;outcontrib[2]:=110;outcontrib[3]:=100;
  439. sendout(2,3);end;5:begin outcontrib[1]:=110;outcontrib[2]:=111;
  440. outcontrib[3]:=116;sendout(2,3);end;6:begin outcontrib[1]:=105;
  441. outcontrib[2]:=110;sendout(2,2);end;31:begin outcontrib[1]:=111;
  442. outcontrib[2]:=114;sendout(2,2);end;24:begin outcontrib[1]:=58;
  443. outcontrib[2]:=61;sendout(1,2);end;26:begin outcontrib[1]:=60;
  444. outcontrib[2]:=62;sendout(1,2);end;28:begin outcontrib[1]:=60;
  445. outcontrib[2]:=61;sendout(1,2);end;29:begin outcontrib[1]:=62;
  446. outcontrib[2]:=61;sendout(1,2);end;30:begin outcontrib[1]:=61;
  447. outcontrib[2]:=61;sendout(1,2);end;32:begin outcontrib[1]:=46;
  448. outcontrib[2]:=46;sendout(1,2);end;{:114}39:{117:}begin k:=1;
  449. outcontrib[1]:=39;repeat if k<linelength then k:=k+1;
  450. outcontrib[k]:=getoutput;until(outcontrib[k]=39)or(stackptr=0);
  451. if k=linelength then begin writeln(stdout);
  452. write(stdout,'! String too long');error;end;sendout(1,k);
  453. curchar:=getoutput;if curchar=39 then outstate:=6;goto 21;end{:117};
  454. {115:}
  455. 33,34,35,36,37,38,40,41,42,44,47,58,59,60,61,62,63,64,91,92,93,94,95,96,
  456. 123,124{:115}:sendout(0,curchar);{121:}
  457. 9:begin if bracelevel=0 then sendout(0,123)else sendout(0,91);
  458. bracelevel:=bracelevel+1;end;
  459. 10:if bracelevel>0 then begin bracelevel:=bracelevel-1;
  460. if bracelevel=0 then sendout(0,125)else sendout(0,93);
  461. end else begin writeln(stdout);write(stdout,'! Extra @}');error;end;
  462. 129:begin if bracelevel=0 then sendout(0,123)else sendout(0,91);
  463. if curval<0 then begin sendout(0,58);sendval(-curval);
  464. end else begin sendval(curval);sendout(0,58);end;
  465. if bracelevel=0 then sendout(0,125)else sendout(0,93);end;{:121}
  466. 127:begin sendout(3,0);outstate:=6;end;2:{118:}begin k:=0;
  467. repeat if k<linelength then k:=k+1;outcontrib[k]:=getoutput;
  468. until(outcontrib[k]=2)or(stackptr=0);
  469. if k=linelength then begin writeln(stdout);
  470. write(stdout,'! Verbatim string too long');error;end;sendout(1,k-1);
  471. end{:118};3:{122:}begin sendout(1,0);
  472. while outptr>0 do begin if outptr<=linelength then breakptr:=outptr;
  473. flushbuffer;end;outstate:=0;end{:122};others:begin writeln(stdout);
  474. write(stdout,'! Can''t output ASCII code ',curchar:1);error;end end;
  475. goto 22;2:{120:}repeat if k<linelength then k:=k+1;
  476. outcontrib[k]:=curchar;curchar:=getoutput;
  477. if(outcontrib[k]=69)and((curchar=43)or(curchar=45))then begin if k<
  478. linelength then k:=k+1;outcontrib[k]:=curchar;curchar:=getoutput;
  479. end else if curchar=101 then curchar:=69;
  480. until(curchar<>69)and((curchar<48)or(curchar>57));
  481. if k=linelength then begin writeln(stdout);
  482. write(stdout,'! Fraction too long');error;end;sendout(3,k);goto 21{:120}
  483. ;22:end;end;{:113}{127:}function linesdontmatch:boolean;label 10;
  484. var k:0..bufsize;begin linesdontmatch:=true;
  485. if changelimit<>limit then goto 10;
  486. if limit>0 then for k:=0 to limit-1 do if changebuffer[k]<>buffer[k]then
  487. goto 10;linesdontmatch:=false;10:end;{:127}{128:}
  488. procedure primethechangebuffer;label 22,30,10;var k:0..bufsize;
  489. begin changelimit:=0;{129:}while true do begin line:=line+1;
  490. if not inputln(changefile)then goto 10;if limit<2 then goto 22;
  491. if buffer[0]<>64 then goto 22;
  492. if(buffer[1]>=88)and(buffer[1]<=90)then buffer[1]:=buffer[1]+32;
  493. if buffer[1]=120 then goto 30;
  494. if(buffer[1]=121)or(buffer[1]=122)then begin loc:=2;
  495. begin writeln(stdout);write(stdout,'! Where is the matching @x?');error;
  496. end;end;22:end;30:{:129};{130:}repeat line:=line+1;
  497. if not inputln(changefile)then begin begin writeln(stdout);
  498. write(stdout,'! Change file ended after @x');error;end;goto 10;end;
  499. until limit>0;{:130};{131:}begin changelimit:=limit;
  500. if limit>0 then for k:=0 to limit-1 do changebuffer[k]:=buffer[k];
  501. end{:131};10:end;{:128}{132:}procedure checkchange;label 10;
  502. var n:integer;k:0..bufsize;begin if linesdontmatch then goto 10;n:=0;
  503. while true do begin changing:=not changing;templine:=otherline;
  504. otherline:=line;line:=templine;line:=line+1;
  505. if not inputln(changefile)then begin begin writeln(stdout);
  506. write(stdout,'! Change file ended before @y');error;end;changelimit:=0;
  507. changing:=not changing;templine:=otherline;otherline:=line;
  508. line:=templine;goto 10;end;{133:}
  509. if limit>1 then if buffer[0]=64 then begin if(buffer[1]>=88)and(buffer[1
  510. ]<=90)then buffer[1]:=buffer[1]+32;
  511. if(buffer[1]=120)or(buffer[1]=122)then begin loc:=2;
  512. begin writeln(stdout);write(stdout,'! Where is the matching @y?');error;
  513. end;end else if buffer[1]=121 then begin if n>0 then begin loc:=2;
  514. begin writeln(stdout);
  515. write(stdout,'! Hmm... ',n:1,' of the preceding lines failed to match');
  516. error;end;end;goto 10;end;end{:133};{131:}begin changelimit:=limit;
  517. if limit>0 then for k:=0 to limit-1 do changebuffer[k]:=buffer[k];
  518. end{:131};changing:=not changing;templine:=otherline;otherline:=line;
  519. line:=templine;line:=line+1;
  520. if not inputln(webfile)then begin begin writeln(stdout);
  521. write(stdout,'! WEB file ended during a change');error;end;
  522. inputhasended:=true;goto 10;end;if linesdontmatch then n:=n+1;end;
  523. 10:end;{:132}{135:}procedure getline;label 20;
  524. begin 20:if changing then{137:}begin line:=line+1;
  525. if not inputln(changefile)then begin begin writeln(stdout);
  526. write(stdout,'! Change file ended without @z');error;end;buffer[0]:=64;
  527. buffer[1]:=122;limit:=2;end;
  528. if limit>1 then if buffer[0]=64 then begin if(buffer[1]>=88)and(buffer[1
  529. ]<=90)then buffer[1]:=buffer[1]+32;
  530. if(buffer[1]=120)or(buffer[1]=121)then begin loc:=2;
  531. begin writeln(stdout);write(stdout,'! Where is the matching @z?');error;
  532. end;end else if buffer[1]=122 then begin primethechangebuffer;
  533. changing:=not changing;templine:=otherline;otherline:=line;
  534. line:=templine;end;end;end{:137};if not changing then begin{136:}
  535. begin line:=line+1;
  536. if not inputln(webfile)then inputhasended:=true else if limit=
  537. changelimit then if buffer[0]=changebuffer[0]then if changelimit>0 then
  538. checkchange;end{:136};if changing then goto 20;end;loc:=0;
  539. buffer[limit]:=32;end;{:135}{139:}
  540. function controlcode(c:ASCIIcode):eightbits;
  541. begin case c of 64:controlcode:=64;39:controlcode:=12;
  542. 34:controlcode:=13;36:controlcode:=125;32,9:controlcode:=136;
  543. 42:begin write(stdout,'*',modulecount+1:1);flush(stdout);
  544. controlcode:=136;end;68,100:controlcode:=133;70,102:controlcode:=132;
  545. 123:controlcode:=9;125:controlcode:=10;80,112:controlcode:=134;
  546. 84,116,94,46,58:controlcode:=131;38:controlcode:=127;
  547. 60:controlcode:=135;61:controlcode:=2;92:controlcode:=3;
  548. others:controlcode:=0 end;end;{:139}{140:}function skipahead:eightbits;
  549. label 30;var c:eightbits;
  550. begin while true do begin if loc>limit then begin getline;
  551. if inputhasended then begin c:=136;goto 30;end;end;buffer[limit+1]:=64;
  552. while buffer[loc]<>64 do loc:=loc+1;if loc<=limit then begin loc:=loc+2;
  553. c:=controlcode(buffer[loc-1]);if(c<>0)or(buffer[loc-1]=62)then goto 30;
  554. end;end;30:skipahead:=c;end;{:140}{141:}procedure skipcomment;label 10;
  555. var bal:eightbits;c:ASCIIcode;begin bal:=0;
  556. while true do begin if loc>limit then begin getline;
  557. if inputhasended then begin begin writeln(stdout);
  558. write(stdout,'! Input ended in mid-comment');error;end;goto 10;end;end;
  559. c:=buffer[loc];loc:=loc+1;{142:}if c=64 then begin c:=buffer[loc];
  560. if(c<>32)and(c<>9)and(c<>42)and(c<>122)and(c<>90)then loc:=loc+1 else
  561. begin begin writeln(stdout);
  562. write(stdout,'! Section ended in mid-comment');error;end;loc:=loc-1;
  563. goto 10;
  564. end end else if(c=92)and(buffer[loc]<>64)then loc:=loc+1 else if c=123
  565. then bal:=bal+1 else if c=125 then begin if bal=0 then goto 10;
  566. bal:=bal-1;end{:142};end;10:end;{:141}{145:}function getnext:eightbits;
  567. label 20,30,31;var c:eightbits;d:eightbits;j,k:0..longestname;
  568. begin 20:if loc>limit then begin getline;
  569. if inputhasended then begin c:=136;goto 31;end;end;c:=buffer[loc];
  570. loc:=loc+1;if scanninghex then{146:}
  571. if((c>=48)and(c<=57))or((c>=65)and(c<=70))then goto 31 else scanninghex
  572. :=false{:146};
  573. case c of 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85
  574. ,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111
  575. ,112,113,114,115,116,117,118,119,120,121,122:{148:}
  576. begin if((c=101)or(c=69))and(loc>1)then if(buffer[loc-2]<=57)and(buffer[
  577. loc-2]>=48)then c:=0;if c<>0 then begin loc:=loc-1;idfirst:=loc;
  578. repeat loc:=loc+1;d:=buffer[loc];
  579. until((d<48)or((d>57)and(d<65))or((d>90)and(d<97))or(d>122))and(d<>95);
  580. if loc>idfirst+1 then begin c:=130;idloc:=loc;end;end else c:=69;
  581. end{:148};34:{149:}begin doublechars:=0;idfirst:=loc-1;
  582. repeat d:=buffer[loc];loc:=loc+1;
  583. if(d=34)or(d=64)then if buffer[loc]=d then begin loc:=loc+1;d:=0;
  584. doublechars:=doublechars+1;
  585. end else begin if d=64 then begin writeln(stdout);
  586. write(stdout,'! Double @ sign missing');error;
  587. end end else if loc>limit then begin begin writeln(stdout);
  588. write(stdout,'! String constant didn''t end');error;end;d:=34;end;
  589. until d=34;idloc:=loc-1;c:=130;end{:149};64:{150:}
  590. begin c:=controlcode(buffer[loc]);loc:=loc+1;
  591. if c=0 then goto 20 else if c=13 then scanninghex:=true else if c=135
  592. then{151:}begin{153:}k:=0;
  593. while true do begin if loc>limit then begin getline;
  594. if inputhasended then begin begin writeln(stdout);
  595. write(stdout,'! Input ended in section name');error;end;goto 30;end;end;
  596. d:=buffer[loc];{154:}if d=64 then begin d:=buffer[loc+1];
  597. if d=62 then begin loc:=loc+2;goto 30;end;
  598. if(d=32)or(d=9)or(d=42)then begin begin writeln(stdout);
  599. write(stdout,'! Section name didn''t end');error;end;goto 30;end;k:=k+1;
  600. modtext[k]:=64;loc:=loc+1;end{:154};loc:=loc+1;
  601. if k<longestname-1 then k:=k+1;if(d=32)or(d=9)then begin d:=32;
  602. if modtext[k-1]=32 then k:=k-1;end;modtext[k]:=d;end;30:{155:}
  603. if k>=longestname-2 then begin begin writeln(stdout);
  604. write(stdout,'! Section name too long: ');end;
  605. for j:=1 to 25 do write(stdout,xchr[modtext[j]]);write(stdout,'...');
  606. if history=0 then history:=1;end{:155};
  607. if(modtext[k]=32)and(k>0)then k:=k-1;{:153};
  608. if k>3 then begin if(modtext[k]=46)and(modtext[k-1]=46)and(modtext[k-2]=
  609. 46)then curmodule:=prefixlookup(k-3)else curmodule:=modlookup(k);
  610. end else curmodule:=modlookup(k);end{:151}
  611. else if c=131 then begin repeat c:=skipahead;until c<>64;
  612. if buffer[loc-1]<>62 then begin writeln(stdout);
  613. write(stdout,'! Improper @ within control text');error;end;goto 20;end;
  614. end{:150};{147:}
  615. 46:if buffer[loc]=46 then begin if loc<=limit then begin c:=32;
  616. loc:=loc+1;end;
  617. end else if buffer[loc]=41 then begin if loc<=limit then begin c:=93;
  618. loc:=loc+1;end;end;
  619. 58:if buffer[loc]=61 then begin if loc<=limit then begin c:=24;
  620. loc:=loc+1;end;end;
  621. 61:if buffer[loc]=61 then begin if loc<=limit then begin c:=30;
  622. loc:=loc+1;end;end;
  623. 62:if buffer[loc]=61 then begin if loc<=limit then begin c:=29;
  624. loc:=loc+1;end;end;
  625. 60:if buffer[loc]=61 then begin if loc<=limit then begin c:=28;
  626. loc:=loc+1;end;
  627. end else if buffer[loc]=62 then begin if loc<=limit then begin c:=26;
  628. loc:=loc+1;end;end;
  629. 40:if buffer[loc]=42 then begin if loc<=limit then begin c:=9;
  630. loc:=loc+1;end;
  631. end else if buffer[loc]=46 then begin if loc<=limit then begin c:=91;
  632. loc:=loc+1;end;end;
  633. 42:if buffer[loc]=41 then begin if loc<=limit then begin c:=10;
  634. loc:=loc+1;end;end;{:147}32,9:goto 20;123:begin skipcomment;goto 20;end;
  635. 125:begin begin writeln(stdout);write(stdout,'! Extra }');error;end;
  636. goto 20;end;others:if c>=128 then goto 20 else end;
  637. 31:{if troubleshooting then debughelp;}getnext:=c;end;{:145}{157:}
  638. procedure scannumeric(p:namepointer);label 21,30;
  639. var accumulator:integer;nextsign:-1..+1;q:namepointer;val:integer;
  640. begin{158:}accumulator:=0;nextsign:=+1;
  641. while true do begin nextcontrol:=getnext;
  642. 21:case nextcontrol of 48,49,50,51,52,53,54,55,56,57:begin{160:}val:=0;
  643. repeat val:=10*val+nextcontrol-48;nextcontrol:=getnext;
  644. until(nextcontrol>57)or(nextcontrol<48){:160};
  645. begin accumulator:=accumulator+nextsign*toint(val);nextsign:=+1;end;
  646. goto 21;end;12:begin{161:}val:=0;nextcontrol:=48;
  647. repeat val:=8*val+nextcontrol-48;nextcontrol:=getnext;
  648. until(nextcontrol>55)or(nextcontrol<48){:161};
  649. begin accumulator:=accumulator+nextsign*toint(val);nextsign:=+1;end;
  650. goto 21;end;13:begin{162:}val:=0;nextcontrol:=48;
  651. repeat if nextcontrol>=65 then nextcontrol:=nextcontrol-7;
  652. val:=16*val+nextcontrol-48;nextcontrol:=getnext;
  653. until(nextcontrol>70)or(nextcontrol<48)or((nextcontrol>57)and(
  654. nextcontrol<65)){:162};
  655. begin accumulator:=accumulator+nextsign*toint(val);nextsign:=+1;end;
  656. goto 21;end;130:begin q:=idlookup(0);
  657. if ilk[q]<>1 then begin nextcontrol:=42;goto 21;end;
  658. begin accumulator:=accumulator+nextsign*toint(equiv[q]-32768);
  659. nextsign:=+1;end;end;43:;45:nextsign:=-nextsign;
  660. 132,133,135,134,136:goto 30;59:begin writeln(stdout);
  661. write(stdout,'! Omit semicolon in numeric definition');error;end;
  662. others:{159:}begin begin writeln(stdout);
  663. write(stdout,'! Improper numeric definition will be flushed');error;end;
  664. repeat nextcontrol:=skipahead until(nextcontrol>=132);
  665. if nextcontrol=135 then begin loc:=loc-2;nextcontrol:=getnext;end;
  666. accumulator:=0;goto 30;end{:159}end;end;30:{:158};
  667. if abs(accumulator)>=32768 then begin begin writeln(stdout);
  668. write(stdout,'! Value too big: ',accumulator:1);error;end;
  669. accumulator:=0;end;equiv[p]:=accumulator+32768;end;{:157}{165:}
  670. procedure scanrepl(t:eightbits);label 22,30,31,21;var a:sixteenbits;
  671. b:ASCIIcode;bal:eightbits;begin bal:=0;
  672. while true do begin 22:a:=getnext;case a of 40:bal:=bal+1;
  673. 41:if bal=0 then begin writeln(stdout);write(stdout,'! Extra )');error;
  674. end else bal:=bal-1;39:{168:}begin b:=39;
  675. while true do begin begin if tokptr[z]=maxtoks then begin writeln(stdout
  676. );write(stdout,'! Sorry, ','token',' capacity exceeded');error;
  677. history:=3;uexit(1);end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;
  678. end;
  679. if b=64 then if buffer[loc]=64 then loc:=loc+1 else begin writeln(stdout
  680. );write(stdout,'! You should double @ signs in strings');error;end;
  681. if loc=limit then begin begin writeln(stdout);
  682. write(stdout,'! String didn''t end');error;end;buffer[loc]:=39;
  683. buffer[loc+1]:=0;end;b:=buffer[loc];loc:=loc+1;
  684. if b=39 then begin if buffer[loc]<>39 then goto 31 else begin loc:=loc+1
  685. ;begin if tokptr[z]=maxtoks then begin writeln(stdout);
  686. write(stdout,'! Sorry, ','token',' capacity exceeded');error;history:=3;
  687. uexit(1);end;tokmem[z,tokptr[z]]:=39;tokptr[z]:=tokptr[z]+1;end;end;end;
  688. end;31:end{:168};35:if t=3 then a:=0;{167:}130:begin a:=idlookup(0);
  689. begin if tokptr[z]=maxtoks then begin writeln(stdout);
  690. write(stdout,'! Sorry, ','token',' capacity exceeded');error;history:=3;
  691. uexit(1);end;tokmem[z,tokptr[z]]:=(a div 256)+128;
  692. tokptr[z]:=tokptr[z]+1;end;a:=a mod 256;end;
  693. 135:if t<>135 then goto 30 else begin begin if tokptr[z]=maxtoks then
  694. begin writeln(stdout);
  695. write(stdout,'! Sorry, ','token',' capacity exceeded');error;history:=3;
  696. uexit(1);end;tokmem[z,tokptr[z]]:=(curmodule div 256)+168;
  697. tokptr[z]:=tokptr[z]+1;end;a:=curmodule mod 256;end;2:{169:}
  698. begin begin if tokptr[z]=maxtoks then begin writeln(stdout);
  699. write(stdout,'! Sorry, ','token',' capacity exceeded');error;history:=3;
  700. uexit(1);end;tokmem[z,tokptr[z]]:=2;tokptr[z]:=tokptr[z]+1;end;
  701. buffer[limit+1]:=64;
  702. 21:if buffer[loc]=64 then begin if loc<limit then if buffer[loc+1]=64
  703. then begin begin if tokptr[z]=maxtoks then begin writeln(stdout);
  704. write(stdout,'! Sorry, ','token',' capacity exceeded');error;history:=3;
  705. uexit(1);end;tokmem[z,tokptr[z]]:=64;tokptr[z]:=tokptr[z]+1;end;
  706. loc:=loc+2;goto 21;end;
  707. end else begin begin if tokptr[z]=maxtoks then begin writeln(stdout);
  708. write(stdout,'! Sorry, ','token',' capacity exceeded');error;history:=3;
  709. uexit(1);end;tokmem[z,tokptr[z]]:=buffer[loc];tokptr[z]:=tokptr[z]+1;
  710. end;loc:=loc+1;goto 21;end;if loc>=limit then begin writeln(stdout);
  711. write(stdout,'! Verbatim string didn''t end');error;
  712. end else if buffer[loc+1]<>62 then begin writeln(stdout);
  713. write(stdout,'! You should double @ signs in verbatim strings');error;
  714. end;loc:=loc+2;end{:169};
  715. 133,132,134:if t<>135 then goto 30 else begin begin writeln(stdout);
  716. write(stdout,'! @',xchr[buffer[loc-1]],' is ignored in Pascal text');
  717. error;end;goto 22;end;136:goto 30;{:167}others:end;
  718. begin if tokptr[z]=maxtoks then begin writeln(stdout);
  719. write(stdout,'! Sorry, ','token',' capacity exceeded');error;history:=3;
  720. uexit(1);end;tokmem[z,tokptr[z]]:=a;tokptr[z]:=tokptr[z]+1;end;end;
  721. 30:nextcontrol:=a;{166:}
  722. if bal>0 then begin if bal=1 then begin writeln(stdout);
  723. write(stdout,'! Missing )');error;end else begin writeln(stdout);
  724. write(stdout,'! Missing ',bal:1,' )''s');error;end;
  725. while bal>0 do begin begin if tokptr[z]=maxtoks then begin writeln(
  726. stdout);write(stdout,'! Sorry, ','token',' capacity exceeded');error;
  727. history:=3;uexit(1);end;tokmem[z,tokptr[z]]:=41;tokptr[z]:=tokptr[z]+1;
  728. end;bal:=bal-1;end;end{:166};
  729. if textptr>maxtexts-4 then begin writeln(stdout);
  730. write(stdout,'! Sorry, ','text',' capacity exceeded');error;history:=3;
  731. uexit(1);end;currepltext:=textptr;tokstart[textptr+4]:=tokptr[z];
  732. textptr:=textptr+1;if z=3 then z:=0 else z:=z+1;end;{:165}{170:}
  733. procedure definemacro(t:eightbits);var p:namepointer;
  734. begin p:=idlookup(t);scanrepl(t);equiv[p]:=currepltext;
  735. textlink[currepltext]:=0;end;{:170}{172:}procedure scanmodule;
  736. label 22,30,10;var p:namepointer;begin modulecount:=modulecount+1;{173:}
  737. nextcontrol:=0;
  738. while true do begin 22:while nextcontrol<=132 do begin nextcontrol:=
  739. skipahead;if nextcontrol=135 then begin loc:=loc-2;nextcontrol:=getnext;
  740. end;end;if nextcontrol<>133 then goto 30;nextcontrol:=getnext;
  741. if nextcontrol<>130 then begin begin writeln(stdout);
  742. write(stdout,'! Definition flushed, must start with ',
  743. 'identifier of length > 1');error;end;goto 22;end;nextcontrol:=getnext;
  744. if nextcontrol=61 then begin scannumeric(idlookup(1));goto 22;
  745. end else if nextcontrol=30 then begin definemacro(2);goto 22;
  746. end else{174:}if nextcontrol=40 then begin nextcontrol:=getnext;
  747. if nextcontrol=35 then begin nextcontrol:=getnext;
  748. if nextcontrol=41 then begin nextcontrol:=getnext;
  749. if nextcontrol=61 then begin begin writeln(stdout);
  750. write(stdout,'! Use == for macros');error;end;nextcontrol:=30;end;
  751. if nextcontrol=30 then begin definemacro(3);goto 22;end;end;end;end;
  752. {:174};begin writeln(stdout);
  753. write(stdout,'! Definition flushed since it starts badly');error;end;
  754. end;30:{:173};{175:}case nextcontrol of 134:p:=0;135:begin p:=curmodule;
  755. {176:}repeat nextcontrol:=getnext;until nextcontrol<>43;
  756. if(nextcontrol<>61)and(nextcontrol<>30)then begin begin writeln(stdout);
  757. write(stdout,'! Pascal text flushed, = sign is missing');error;end;
  758. repeat nextcontrol:=skipahead;until nextcontrol=136;goto 10;end{:176};
  759. end;others:goto 10 end;{177:}storetwobytes(53248+modulecount);{:177};
  760. scanrepl(135);{178:}
  761. if p=0 then begin textlink[lastunnamed]:=currepltext;
  762. lastunnamed:=currepltext;
  763. end else if equiv[p]=0 then equiv[p]:=currepltext else begin p:=equiv[p]
  764. ;while textlink[p]<maxtexts do p:=textlink[p];textlink[p]:=currepltext;
  765. end;textlink[currepltext]:=maxtexts;{:178};{:175};10:end;{:172}{181:}
  766. {procedure debughelp;label 888,10;var k:integer;
  767. begin debugskipped:=debugskipped+1;
  768. if debugskipped<debugcycle then goto 10;debugskipped:=0;
  769. while true do begin write(stdout,'#');flush(stdout);read(stdin,ddt);
  770. if ddt<0 then goto 10 else if ddt=0 then begin goto 888;
  771. 888:ddt:=0;
  772. end else begin read(stdin,dd);case ddt of 1:printid(dd);2:printrepl(dd);
  773. 3:for k:=1 to dd do write(stdout,xchr[buffer[k]]);
  774. 4:for k:=1 to dd do write(stdout,xchr[modtext[k]]);
  775. 5:for k:=1 to outptr do write(stdout,xchr[outbuf[k]]);
  776. 6:for k:=1 to dd do write(stdout,xchr[outcontrib[k]]);
  777. others:write(stdout,'?')end;end;end;10:end;}{:181}{182:}
  778. begin initialize;{134:}openinput;line:=0;otherline:=0;changing:=true;
  779. primethechangebuffer;changing:=not changing;templine:=otherline;
  780. otherline:=line;line:=templine;limit:=0;loc:=1;buffer[0]:=32;
  781. inputhasended:=false;{:134};write(stdout,'This is TANGLE, Version 4.3');
  782. writeln(stdout,versionstring);{183:}phaseone:=true;modulecount:=0;
  783. repeat nextcontrol:=skipahead;until nextcontrol=136;
  784. while not inputhasended do scanmodule;{138:}
  785. if changelimit<>0 then begin for ii:=0 to changelimit do buffer[ii]:=
  786. changebuffer[ii];limit:=changelimit;changing:=true;line:=otherline;
  787. loc:=changelimit;begin writeln(stdout);
  788. write(stdout,'! Change file entry did not match');error;end;end{:138};
  789. phaseone:=false;{:183};{for ii:=0 to 3 do maxtokptr[ii]:=tokptr[ii];}
  790. {112:}if textlink[0]=0 then begin begin writeln(stdout);
  791. write(stdout,'! No output was specified.');end;
  792. if history=0 then history:=1;end else begin begin writeln(stdout);
  793. write(stdout,'Writing the output file');end;flush(stdout);{83:}
  794. stackptr:=1;bracelevel:=0;curstate.namefield:=0;
  795. curstate.replfield:=textlink[0];zo:=curstate.replfield mod 4;
  796. curstate.bytefield:=tokstart[curstate.replfield];
  797. curstate.endfield:=tokstart[curstate.replfield+4];curstate.modfield:=0;
  798. {:83};{96:}outstate:=0;outptr:=0;breakptr:=0;semiptr:=0;outbuf[0]:=0;
  799. line:=1;{:96};sendtheoutput;{98:}breakptr:=outptr;semiptr:=0;
  800. flushbuffer;if bracelevel<>0 then begin writeln(stdout);
  801. write(stdout,'! Program ended at brace level ',bracelevel:1);error;end;
  802. {:98};begin writeln(stdout);write(stdout,'Done.');end;end{:112};
  803. 9999:if stringptr>256 then{184:}begin begin writeln(stdout);
  804. write(stdout,stringptr-256:1,' strings written to string pool file.');
  805. end;write(pool,'*');
  806. for ii:=1 to 9 do begin outbuf[ii]:=poolchecksum mod 10;
  807. poolchecksum:=poolchecksum div 10;end;
  808. for ii:=9 downto 1 do write(pool,xchr[48+outbuf[ii]]);writeln(pool);
  809. end{:184};{[186:]begin writeln(stdout);
  810. write(stdout,'Memory usage statistics:');end;begin writeln(stdout);
  811. write(stdout,nameptr:1,' names, ',textptr:1,' replacement texts;');end;
  812. begin writeln(stdout);write(stdout,byteptr[0]:1);end;
  813. for wo:=1 to 2 do write(stdout,'+',byteptr[wo]:1);
  814. if phaseone then for ii:=0 to 3 do maxtokptr[ii]:=tokptr[ii];
  815. write(stdout,' bytes, ',maxtokptr[0]:1);
  816. for ii:=1 to 3 do write(stdout,'+',maxtokptr[ii]:1);
  817. write(stdout,' tokens.');[:186];}{187:}
  818. case history of 0:begin writeln(stdout);
  819. write(stdout,'(No errors were found.)');end;1:begin writeln(stdout);
  820. write(stdout,'(Did you see the warning message above?)');end;
  821. 2:begin writeln(stdout);
  822. write(stdout,'(Pardon me, but I think I spotted something wrong.)');end;
  823. 3:begin writeln(stdout);
  824. write(stdout,'(That was a fatal error, my friend.)');end;end{:187};
  825. writeln(stdout);if(history<>0)and(history<>1)then uexit(1)else uexit(0);
  826. end.{:182}
  827.